home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qbasicpg.zip / VIDEO.BAS < prev    next >
BASIC Source File  |  1989-08-31  |  13KB  |  325 lines
  1. ' VIDEO.BAS
  2. ' This is a simple database program that tracks a home video collection
  3. '   with a sequential file and a number of general purpose subprograms.
  4.  
  5. DECLARE SUB DisplayHeader ()            ' declare subprograms
  6. DECLARE SUB GetMenuSelection (choice%)
  7. DECLARE SUB AddRecords ()
  8. DECLARE SUB ViewRecords ()
  9. DECLARE SUB PrintRecords ()
  10. DECLARE SUB Search ()
  11. DECLARE SUB ChangeFilename ()
  12.  
  13. COMMON SHARED filename$, tmp$           ' declare global variables
  14. filename$ = "VIDEO.DB"                  ' default database filename
  15. OPEN filename$ FOR APPEND AS #1: CLOSE #1  ' ensure that file exists
  16. tmp$ = "Year:    ####        Type:  \         \ Medium:  \           \"
  17.  
  18. DisplayHeader                           ' call sub to set up screen
  19.  
  20. DO
  21.     GetMenuSelection choice%            ' call sub to get menu choice
  22.  
  23.     SELECT CASE choice%                 ' process menu choice
  24.         CASE 1                             ' "1" means add to database
  25.             LOCATE 3, 47: PRINT "ADD   "   '   change mode to ADD
  26.             AddRecords                     '   call sub to add items
  27.         CASE 2                             ' "2" means view database
  28.             LOCATE 3, 47: PRINT "VIEW  "   '   change mode to VIEW
  29.             ViewRecords                    '   call sub to view items
  30.         CASE 3                             ' "3" means print database
  31.             LOCATE 3, 47: PRINT "PRINT "   '   change mode to PRINT
  32.             PrintRecords                   '   call sub to print
  33.         CASE 4                             ' "4" means search database
  34.             LOCATE 3, 47: PRINT "SEARCH"   '   change mode to SEARCH
  35.             Search                         '   call sub to search
  36.         CASE 5                             ' "5" means change filename
  37.             LOCATE 3, 47: PRINT "CHANGE"   '   change mode to CHANGE
  38.             ChangeFilename                 '   call sub to change it
  39.         CASE 6                             ' "6" means exit to DOS
  40.             CLS                            '   clear screen
  41.             SHELL                          '   exit to DOS shell
  42.             DisplayHeader                  '   set up screen on return
  43.         CASE 7                             ' "7" means quit program
  44.             LOCATE 3, 47: PRINT "QUIT  "   '   change mode to QUIT
  45.     END SELECT
  46.  
  47. LOOP UNTIL (choice% = 7)                ' repeat loop until QUIT chosen
  48.  
  49. END
  50.  
  51. SUB AddRecords
  52.  
  53. ' The AddRecords subprogram adds new video items to the database.
  54.  
  55. LOCATE 25, 1                        ' print message on status line
  56. PRINT "Enter video data.  Type END for title to quit...";
  57. VIEW PRINT 5 TO 23                  ' enable viewport (lines 5-23)
  58. PRINT                               ' prompt for data
  59. PRINT "Enter new video information (without commas)"
  60. PRINT
  61.  
  62. OPEN filename$ FOR APPEND AS #1     ' open database in append mode
  63.  
  64. ' get records for file until user enters END for title
  65.  
  66. WHILE (UCASE$(title$) <> "END")
  67.     INPUT "Item title:  ", title$   ' get item title
  68.  
  69.     IF (UCASE$(title$) <> "END") THEN   ' ...and other video info
  70.         INPUT "   Significant actors/contributors:  ", actor$
  71.         INPUT "   Year released:  ", year%
  72.         INPUT "   Type of video:  ", type$
  73.         INPUT "   Item medium type:  ", medium$
  74.         PRINT
  75.                                    ' write record to database file
  76.         WRITE #1, title$, actor$, year%, type$, medium$
  77.     END IF
  78. WEND
  79.  
  80. CLOSE #1                            ' close file when finished
  81.  
  82. END SUB
  83.  
  84. SUB ChangeFilename
  85.  
  86. ' The ChangeFilename subprogram changes the name of the current
  87. '   database file. If the new file does not exist, it is created.
  88. '   If no filename is specified, the default value of VIDEO.DB is
  89. '   assumed.  Note:  This subprogram does only minimal checking
  90. '   for a valid DOS filename -- if an invalid name is entered the
  91. '   program will terminate.
  92.  
  93. LOCATE 25, 1: PRINT "Specify new video database filename...";
  94. VIEW PRINT 5 TO 23                ' print message on status line
  95.  
  96. PRINT                             ' prompt for a new filename
  97. PRINT "Use this option create a new video database file or open";
  98. PRINT " an existing one."
  99. PRINT
  100. PRINT "The current directory contains the following files:"
  101. PRINT
  102. FILES "*.*"                       ' display all files in the current
  103. PRINT                             '   directory to help user
  104. PRINT "What video collection data file would you like to work with?"
  105. PRINT "(Press Enter for default database file VIDEO.DB)"
  106. PRINT
  107. INPUT "Filename:  ", filename$    ' assign input to global variable
  108.  
  109. IF (filename$ = "") THEN          ' if no filename entered then
  110.     filename$ = "VIDEO.DB"        '   set filename to VIDEO.DB
  111. ELSE                              ' otherwise trim blank spaces off
  112.     filename$ = LTRIM$(RTRIM$(UCASE$(filename$)))
  113. END IF                            '   both ends of file and change to
  114.                                   '   uppercase
  115. OPEN filename$ FOR APPEND AS #1   ' open and close file to ensure it
  116. CLOSE #1                          '   exists on disk (this avoids file
  117.                                   '   error when opening in INPUT mode)
  118. END SUB
  119.  
  120. SUB DisplayHeader
  121.  
  122. ' The DisplayHeader subprogram displays the status information on the
  123. '   first three lines of the screen and the two dividing lines that set
  124. '   off program information window.
  125.  
  126. CLS                                      ' clear screen
  127.  
  128. COLOR 9                                  ' set color to light blue
  129.  
  130. PRINT "                         V I D E O  C O L L E C T I O N"
  131. PRINT
  132. PRINT "Current file:                  "; ' display status fields
  133. PRINT "Current mode:                ";
  134. PRINT "Current time:"
  135.  
  136. PRINT STRING$(80, "-")                   ' print dividing lines
  137. LOCATE 24, 1: PRINT STRING$(80, "-");    '   on lines 4 and 24
  138.  
  139. COLOR 7                                  ' set color to default white
  140.  
  141. END SUB
  142.  
  143. SUB GetMenuSelection (choice%)
  144.  
  145. ' The GetMenuSelection subprogram gets a menu choice from the user
  146. '   and returns it to the main program in the choice% variable.
  147. '   The VIEW PRINT statement is used to enable and disable the
  148. '   viewport area (lines 5-23). The information displayed here does
  149. '   not disturb the data in lines 1 through 4 and 24 through 25.
  150.  
  151. choice% = 0                ' initialize choice% to zero
  152.  
  153. VIEW PRINT                 ' disable viewport to update lines 3 and 25
  154. LOCATE 3, 16: PRINT "                ": LOCATE 3, 16: PRINT filename$
  155. LOCATE 3, 47: PRINT "SELECT"          ' set current mode to select
  156. LOCATE 3, 76: PRINT LEFT$(TIME$, 5)   ' update current time
  157. LOCATE 25, 1: PRINT "Type a number between 1 and 7 and press Enter...";
  158. VIEW PRINT 5 TO 23         ' enable viewport (lines 5-23)
  159. CLS 2                      ' clear viewport for choice prompts
  160.  
  161. PRINT                      ' prompt user for choice
  162. PRINT "SELECT an option:"
  163. PRINT
  164. PRINT "  1) ADD entries to video database and save on disk"
  165. PRINT "  2) VIEW contents of video database on screen"
  166. PRINT "  3) PRINT video database on system printer"
  167. PRINT "  4) SEARCH for a specific entry in video database"
  168. PRINT "  5) CHANGE video database filename"
  169. PRINT "  6) EXIT temporarily to DOS (type 'exit' to return)"
  170. PRINT "  7) QUIT video database program"
  171. PRINT
  172.                            ' choice must be integer between 1 and 7
  173. DO WHILE (choice% < 1) OR (choice% > 7)
  174.     INPUT "Choice (1-7):  ", choice%
  175. LOOP
  176.    
  177. CLS 2                      ' clear viewport for upcoming choice
  178. VIEW PRINT                 ' disable viewport to clear status line
  179. LOCATE 25, 1: PRINT STRING$(80, " ");  ' print a blank line
  180.  
  181. END SUB
  182.  
  183. SUB PrintRecords
  184.  
  185. ' The PrintRecords subprogram sends the entire contents of the current
  186. '   database file to the printer.
  187.  
  188. VIEW PRINT 5 TO 23                   ' enable viewport (lines 5-23)
  189. PRINT                                ' display introductory message
  190. PRINT "This option sends the contents of "; filename$;
  191. PRINT " to your printer."
  192.  
  193. VIEW PRINT                           ' disable viewport so status
  194. LOCATE 25, 1                         '   line can be updated
  195. INPUT ; "Type P to print or R to return to main menu:  ", reply$
  196. VIEW PRINT 5 TO 23                   ' enable viewport (lines 5-23)
  197.                                      ' if user wants to print (P or p)
  198. IF (reply$ = "P") OR (reply$ = "p") THEN
  199.     OPEN filename$ FOR INPUT AS #1   ' open the video database file
  200.                                      ' send header to printer
  201.     LPRINT "------------------- Video Collection -------------------"
  202.     LPRINT
  203.     LPRINT "Date printed:  "; DATE$  ' print current date
  204.     LPRINT "Filename:      "; filename$  ' print current filename
  205.     LPRINT
  206.     LPRINT "Collection contents:"
  207.     LPRINT
  208.                                      ' until file contents exhausted
  209.     DO WHILE (NOT EOF(1))            '   read a record from file
  210.         INPUT #1, title$, actor$, year%, type$, medium$
  211.    
  212.         LPRINT "Title:   "; title$   '  print each field of the record
  213.         LPRINT "Actors:  "; actor$
  214.         LPRINT "Year:   "; year%
  215.         LPRINT "Type:   "; type$
  216.         LPRINT "Medium:  "; medium$
  217.         LPRINT
  218.     LOOP
  219.  
  220.     LPRINT CHR$(12)               ' send formfeed character to printer
  221.     CLOSE #1                      ' close file
  222. END IF
  223.  
  224. END SUB
  225.  
  226. SUB Search
  227.  
  228. ' The Search subprogram searches the entire database file for records
  229. '   matching a search string entered by the user.  Search currently
  230. '   supports searches for title and actor fields--additional topics
  231. '   can be included by adding extra CASE statements.
  232.  
  233. num% = 0                              ' initialize catagory variable
  234. found% = 0                            ' initialize "record found" flag
  235.  
  236. LOCATE 25, 1                          ' update status line
  237. PRINT "Enter search category and content...";
  238. VIEW PRINT 5 TO 23                    ' enable viewport (lines 5-23)
  239.  
  240. PRINT
  241. PRINT "Select a search category:"     ' prompt for search topic
  242. PRINT
  243. PRINT "  1) Search for title"
  244. PRINT "  2) Search for actors/contributors"
  245. PRINT
  246.  
  247. DO WHILE (num% < 1) OR (num% > 2)     ' get number associated with
  248.     INPUT "Category (1-2):  ", num%   '   search topic
  249. LOOP
  250.  
  251. PRINT                                 ' get search string
  252. INPUT "Enter string to be searched for:  ", searchStr$
  253. PRINT
  254. PRINT "Search results:"               ' display search results
  255. PRINT
  256.  
  257. OPEN filename$ FOR INPUT AS #1        ' open database file
  258.  
  259. DO WHILE (NOT EOF(1))                 ' read records from file
  260.     INPUT #1, title$, actor$, year%, type$, medium$
  261.  
  262.     SELECT CASE num% ' use num% to compare correct record field... 
  263.     CASE 1   ' if num% = 1, determine if search string in title field
  264.         IF INSTR(UCASE$(title$), UCASE$(searchStr$)) THEN
  265.             found% = -1               ' if so, set found flag to true
  266.             COLOR 2: PRINT "Title:   "; title$: COLOR 7
  267.             PRINT "Actors:  "; actor$
  268.             PRINT USING tmp$; year%; type$; medium$
  269.             PRINT    ' display record fields with title field in green
  270.          END IF
  271.     CASE 2   ' if num% = 2, determine if search string in actor field
  272.         IF INSTR(UCASE$(actor$), UCASE$(searchStr$)) THEN
  273.             found% = -1               ' if so, set found flag to true
  274.             PRINT "Title:   "; title$
  275.             COLOR 2: PRINT "Actors:  "; actor$: COLOR 7
  276.             PRINT USING tmp$; year%; type$; medium$
  277.             PRINT    ' display record fields with title field in green
  278.          END IF
  279.     END SELECT
  280. LOOP
  281.  
  282. CLOSE #1                              ' close file
  283. IF (NOT found%) THEN                  ' if file not found display
  284.     COLOR 2: PRINT searchStr$;        '   "not found" message
  285.     COLOR 7: PRINT " not found in "; filename$; " database"
  286. END IF
  287.  
  288. VIEW PRINT           ' disable viewport and update status line
  289. LOCATE 25, 1: INPUT ; "Press Enter to return to main menu...", dummy$
  290.  
  291. END SUB
  292.  
  293. SUB ViewRecords
  294.    
  295. ' The ViewRecords subprogram displays each record in the database on
  296. '   the screen one at a time.
  297.  
  298. LOCATE 25, 1                           ' update status line
  299. PRINT "Press Enter to continue...";
  300.  
  301. VIEW PRINT 5 TO 23                     ' enable viewport (lines 5-23)
  302. PRINT                                  ' display opening message
  303. PRINT "This option lets you view your video collection ";
  304. PRINT "one record at at time."
  305. PRINT
  306.  
  307. OPEN filename$ FOR INPUT AS #1         ' open database file
  308.  
  309. DO WHILE (NOT EOF(1))                  ' get record from file
  310.     INPUT #1, title$, actor$, year%, type$, medium$
  311.   
  312.     PRINT "Title:   "; title$          ' display each field on screen
  313.     PRINT "Actors:  "; actor$
  314.     PRINT USING tmp$; year%; type$; medium$
  315.    
  316.     INPUT "", dummy$                   ' pause after each record
  317. LOOP
  318.  
  319. CLOSE #1                               ' close file
  320. PRINT "** End of file reached **"      ' display EOF message
  321. INPUT "", dummy$                       ' pause before returning to
  322.                                        '   to main program
  323. END SUB
  324.  
  325.